{*******************************************************************************
* The contents of this file are used with permission, subject to the Mozilla   *
* Public License Version 1.1 (the "License"); you may not use this file except *
* in compliance with the License. You may obtain a copy of the License at      *
* http://www.mozilla.org/MPL/                                                  *
*                                                                              *
* Software distributed under the License is distributed on an "AS IS" basis,   *
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for *
* the specific language governing rights and limitations under the License.    *
*                                                                              *
* The Original Code is distributed as part of the "mediate" product and is     *
* Copyright (C) @home media limited. All Rights Reserved.                      *
*                                                                              *
* Email: support@athomemedia.co.uk                                             *
* Web:   http://www.athomemedia.co.uk                                          *
*******************************************************************************}

unit Fonts;

interface

uses Classes, UIObjects, Graphics, Colours, Canvas, XMLHelper, AHMTypes;

{$IFDEF DESIGNER}
const
  MODIFY_CAPTION = 'Edit Font';
  GREEKING_TEXT = 'Lorem ipsum dolor sit amet, consectetur adipisicing elit, ' +
                  'sed do eiusmod tempor incididunt ut labore et dolore ' +
                  'magna aliqua. Ut enim ad minim veniam, quis nostrud ' +
                  'exercitation ullamco laboris nisi ut aliquip ex ea ' +
                  'commodo consequat. Duis aute irure dolor in ' +
                  'reprehenderit in voluptate velit esse cillum dolore eu ' +
                  'fugiat nulla pariatur. Excepteur sint occaecat cupidatat ' +
                  'non proident, sunt in culpa qui officia deserunt mollit ' +
                  'anim id est laborum.';
  SAMPLE_TEXT = '!"#$%&''()*+,-./0123456789:;<=>?' + sLineBreak +
                '@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_' + sLineBreak +
                '`abcdefghijklmnopqrstuvwxyz{|}~';

  // Property categories and hints for designer
  CAT_FONT = 'Font';
  HINT_COLOUR = 'specifies the name of a colour item to use for tinting the font';
  HINT_SHADOWCOLOUR = 'specifies the name of a colour item to use for drawing the font shadow';
  HINT_OUTLINECOLOUR = 'specifies the name of a colour item to use for drawing the font outline';
  HINT_OUTLINEWIDTH = 'specifies the width of the font outline (if outline enabled)';
  HINT_SHADOWX = 'specifies the horizontal offset for the font shadow (if shadow enabled)';
  HINT_SHADOWY = 'specifies the vertical offset for the font shadow (if shadow enabled)';
  HINT_SIZE = 'specifies the point size of the font';
  HINT_TYPEFACE = 'specifies the typeface of the font';
  HINT_BOLD = 'determines whether the font will be drawn in a bold typeface';
  HINT_ITALIC = 'determines whether the font will be drawn in an italic typeface';
  HINT_UNDERLINE = 'determines whether the font will be drawn in an underline typeface';
  HINT_SHADOW = 'determines whether the font will be drawn with a shadow';
  HINT_OUTLINE = 'determines whether the font will be drawn with an outline';
  HINT_GLOW = 'determines whether the font will be drawn with a glow effect';
{$ENDIF}

type
  TAHMFont = class(TAHMUIObject)
  private
    FColour: TAHMColour;
    FOutlineColour: TAHMColour;
    FVirtOutlineWidth: Integer;
    FVirtShadowX: Integer;
    FVirtShadowY: Integer;
    FVirtSize: Integer;
    FShadowColour: TAHMColour;
    FFont: TAHMCanvasFont;
  protected
    procedure SetColour(Colour: TAHMColour);
    procedure SetShadowColour(Colour: TAHMColour);
    procedure SetOutlineColour(Colour: TAHMColour);
    procedure SetVirtualOutlineWidth(Width: Integer);
    procedure SetVirtualShadowXOffset(X: Integer);
    procedure SetVirtualShadowYOffset(Y: Integer);
    procedure SetVirtualSize(Size: Integer);
    function GetTypeface: TAHMTypeface;
    procedure SetTypeface(Typeface: TAHMTypeface);
    function GetBold: Boolean;
    procedure SetBold(Bold: Boolean);
    function GetItalic: Boolean;
    procedure SetItalic(Italic: Boolean);
    function GetUnderline: Boolean;
    procedure SetUnderline(Underline: Boolean);
    function GetShadow: Boolean;
    procedure SetShadow(Shadow: Boolean);
    function GetOutline: Boolean;
    procedure SetOutline(Outline: Boolean);
    function GetGlow: Boolean;
    procedure SetGlow(Glow: Boolean);
    procedure ClearProperties; override;
  public
    constructor Create(const Name: String); override;
    destructor Destroy; override;
    property Font: TAHMCanvasFont read FFont;
    function RenderPreview: Boolean; override;
    function ModifyActions: Integer; override;
    function Modify(Action: Integer): Boolean; override;
    function ModifyCaption(Action: Integer): String; override;
    procedure SeedObject; override;
    procedure Assign(Source: TPersistent); override;
    procedure SaveXMLBody(Lines: TStrings); override;
    procedure ParseFromXML(XML: TAHMXMLHelper); override;
    procedure InvalidateUIObject(UIObject: TAHMUIObject); override;
    procedure BuildProperties(Properties: TAHMUIPropertyList); override;
  published
    property Colour: TAHMColour read FColour write SetColour;
    property ShadowColour: TAHMColour read FShadowColour write SetShadowColour;
    property OutlineColour: TAHMColour read FOutlineColour write SetOutlineColour;
    property VirtualOutlineWidth: Integer read FVirtOutlineWidth write SetVirtualOutlineWidth;
    property VirtualShadowXOffset: Integer read FVirtShadowX write SetVirtualShadowXOffset;
    property VirtualShadowYOffset: Integer read FVirtShadowY write SetVirtualShadowYOffset;
    property VirtualSize: Integer read FVirtSize write SetVirtualSize;
    property Typeface: TAHMTypeface read GetTypeface write SetTypeface;
    property Bold: Boolean read GetBold write SetBold;
    property Italic: Boolean read GetItalic write SetItalic;
    property Underline: Boolean read GetUnderline write SetUnderline;
    property Shadow: Boolean read GetShadow write SetShadow;
    property Outline: Boolean read GetOutline write SetOutline;
    property Glow: Boolean read GetGlow write SetGlow;
  end;

  TAHMFontList = class(TAHMUIObjectList)
  private
  protected
  public
    constructor Create; override;
    function AddFont(const InheritFrom, NewName: String): TAHMFont;
    function GetFont(const Name: String): TAHMFont;
    procedure PopulateDefaultObjects; override;
    procedure CleardownDefaultObjects; override;
  end;


implementation

uses SysUtils, ApplicationManager, TagNames, XMLTags, ErrorCodes,
     {$IFDEF DESIGNER}DesignerPropsEdit,{$ENDIF} Screen;

constructor TAHMFontList.Create;
begin
  inherited Create;

  XMLTagName := TAG_FONTS;
  ChildClass := TAHMFont;
end;

function TAHMFontList.AddFont(const InheritFrom, NewName: String): TAHMFont;
begin
  Result := TAHMFont(Inherit(InheritFrom, NewName));
end;

function TAHMFontList.GetFont(const Name: String): TAHMFont;
begin
  Result := TAHMFont(GetObject(Name));
end;

procedure TAHMFontList.PopulateDefaultObjects;
begin
  with DefaultObject as TAHMFont do
  begin
    Colour := TAHMColour.Create('White');
    Colour.ColourDef := 'c0ffffff';
    ShadowColour := TAHMColour.Create('Black');
    ShadowColour.ColourDef := 'c0000000';
    Shadow := True;
    VirtualShadowXOffset := 2;
    VirtualShadowYOffset := 2;
    VirtualSize := 20;
    Typeface := 'Arial';
  end;
end;

procedure TAHMFontList.CleardownDefaultObjects;
begin
  with DefaultObject as TAHMFont do
  begin
    Colour.Free;
    ShadowColour.Free;
  end;
end;

//----------------------------------------------------------------------------//
constructor TAHMFont.Create(const Name: String);
begin
  inherited Create(Name);

  XMLTagName := TAG_FONT;
  ObjectType := otFonts;
  ImageIndex := Ord(otFonts);

  FFont := TAHMCanvasFont.Create;
end;

destructor TAHMFont.Destroy;
begin
  FFont.Free;

  inherited Destroy;
end;

procedure TAHMFont.SetColour(Colour: TAHMColour);
begin
  FColour := Colour;
  if FColour <> nil then
    FFont.Colour := FColour.Colour
  else
    FFont.Colour := nil;
  FFont.Invalidate;
end;

procedure TAHMFont.SetShadowColour(Colour: TAHMColour);
begin
  FShadowColour := Colour;
  if FShadowColour <> nil then
  begin
    FFont.ShadowColour := FShadowColour.Colour;
    FFont.Shadow := True;
  end
  else
  begin
    FFont.ShadowColour := nil;
    FFont.Shadow := False;
  end;
end;

procedure TAHMFont.SetOutlineColour(Colour: TAHMColour);
begin
  FOutlineColour := Colour;
  if FOutlineColour <> nil then
    FFont.OutlineColour := FOutlineColour.Colour
  else
    FFont.OutlineColour := nil;
  FFont.Invalidate;
end;

procedure TAHMFont.SetVirtualOutlineWidth(Width: Integer);
begin
  FVirtOutlineWidth := Width;
  FFont.OutlineWidth := ScreenInstance.ScaleVirtualValue(Width);
  FFont.Invalidate;
end;

procedure TAHMFont.SetVirtualShadowXOffset(X: Integer);
begin
  FVirtShadowX := X;
  FFont.ShadowXOffset := ScreenInstance.ScaleVirtualX(X);
end;

procedure TAHMFont.SetVirtualShadowYOffset(Y: Integer);
begin
  FVirtShadowY := Y;
  FFont.ShadowYOffset := ScreenInstance.ScaleVirtualY(Y);
end;

procedure TAHMFont.SetVirtualSize(Size: Integer);
begin
  FVirtSize := Size;
  FFont.Size := Size; // fonts are now scaled in DirectX layer to save memory
  FFont.Invalidate;
end;

function TAHMFont.GetTypeface: TAHMTypeface;
begin
  Result := FFont.Typeface;
end;

procedure TAHMFont.SetTypeface(Typeface: TAHMTypeface);
begin
  if FFont.Typeface <> Typeface then
  begin
    FFont.Typeface := Typeface;
    FFont.Invalidate;
  end;
end;

function TAHMFont.GetBold: Boolean;
begin
  Result := FFont.Bold;
end;

procedure TAHMFont.SetBold(Bold: Boolean);
begin
  if FFont.Bold <> Bold then
  begin
    FFont.Bold := Bold;
    FFont.Invalidate;
  end;
end;

function TAHMFont.GetItalic: Boolean;
begin
  Result := FFont.Italic;
end;

procedure TAHMFont.SetItalic(Italic: Boolean);
begin
  if FFont.Italic <> Italic then
  begin
    FFont.Italic := Italic;
    FFont.Invalidate;
  end;
end;

function TAHMFont.GetUnderline: Boolean;
begin
  Result := FFont.Underline;
end;

procedure TAHMFont.SetUnderline(Underline: Boolean);
begin
  if FFont.Underline <> Underline then
  begin
    FFont.Underline := Underline;
    FFont.Invalidate;
  end;
end;

function TAHMFont.GetShadow: Boolean;
begin
  Result := FFont.Shadow;
end;

procedure TAHMFont.SetShadow(Shadow: Boolean);
begin
  FFont.Shadow := Shadow;
end;

function TAHMFont.GetOutline: Boolean;
begin
  Result := FFont.Outline;
end;

procedure TAHMFont.SetOutline(Outline: Boolean);
begin
  if FFont.Outline <> Outline then
  begin
    FFont.Outline := Outline;
    FFont.Invalidate;
  end;
end;

function TAHMFont.GetGlow: Boolean;
begin
  Result := FFont.Glow;
end;

procedure TAHMFont.SetGlow(Glow: Boolean);
begin
  if FFont.Glow <> Glow then
  begin
    FFont.Glow := Glow;
    FFont.Invalidate;
  end;
end;

procedure TAHMFont.ClearProperties;
begin
  inherited;

  // Clear custom font properties
  FColour := nil;
  FOutlineColour := nil;
  VirtualOutlineWidth := 0;
  VirtualShadowXOffset := 0;
  VirtualShadowYOffset := 0;
  VirtualSize := 0;
  FShadowColour := nil;
  FFont.Clear;
end;

function TAHMFont.RenderPreview: Boolean;
begin
{$IFDEF DESIGNER}
  with ScreenInstance.Viewport do
  begin
    Canvas.DesignerBackground(ViewportRect);
    Canvas.TextRect(ViewportRect, FFont, GREEKING_TEXT, taLeft, True,
                    nil, nil, nil, 1.0, 1.0, False, False);
  end;
{$ENDIF}
  Result := True;
end;

function TAHMFont.ModifyActions: Integer;
begin
  // Font only supports displaying font dialog
  Result := 1;
end;

function TAHMFont.Modify(Action: Integer): Boolean;
begin
{$IFDEF DESIGNER}
  // Edit font with property dialog
  Result := TfrmObjectProperties.EditObject(Self, Owner);
  if Result then DoModified;
{$ELSE}
  Result := False;
{$ENDIF}
end;

function TAHMFont.ModifyCaption(Action: Integer): String;
begin
{$IFDEF DESIGNER}
  Result := MODIFY_CAPTION;
{$ELSE}
  Result := '';
{$ENDIF}
end;

procedure TAHMFont.SeedObject;
begin
{$IFDEF DESIGNER}
  if Ancestor = nil then
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      ShadowColour := ColourList.GetColour(DEFAULT_OBJECT_NAME);
      Colour := ColourList.GetColour(DEFAULT_WHITE_NAME);
      Shadow := True;
      VirtualShadowXOffset := 2;
      VirtualShadowYOffset := 2;
      VirtualSize := 20;
      Typeface := 'Arial';
    end;
{$ENDIF}
end;

procedure TAHMFont.Assign(Source: TPersistent);
begin
  inherited Assign(Source);

  with Source as TAHMFont do
  begin
    Self.Font.Assign(Font);
    Self.Colour := Colour;
    Self.OutlineColour := OutlineColour;
    Self.VirtualOutlineWidth := VirtualOutlineWidth;
    Self.VirtualShadowXOffset := VirtualShadowXOffset;
    Self.VirtualShadowYOffset := VirtualShadowYOffset;
    Self.VirtualSize := VirtualSize;
    Self.ShadowColour := ShadowColour;
  end;
end;

procedure TAHMFont.SaveXMLBody(Lines: TStrings);
var
  oAncs: TAHMFont;
  sWork: String;
begin
  // Determine which ancestor to compare against - real or empty
  oAncs := TAHMFont(ObjectToCompare);

  with FFont do
  begin
    // Only populate attributes that differ from our ancestor
    if (Typeface <> '') and (Typeface <> oAncs.Font.Typeface) then
      Lines.Add(TABS[3] + TGB+TAG_TYPEFACE+TGC + EncodeXML(Typeface) + TGE+TAG_TYPEFACE+TGC);
    if (FVirtSize <> 0) and (FVirtSize <> oAncs.VirtualSize) then
      Lines.Add(TABS[3] + TGB+TAG_SIZE+TGC + IntToStr(FVirtSize) + TGE+TAG_SIZE+TGC);
    if (FColour <> nil) and (FColour <> oAncs.Colour) then
      Lines.Add(TABS[3] + FColour.XMLReference);

    // Do we need to store characteristics?
    if (Bold and (Bold <> oAncs.Font.Bold)) or (Italic and (Italic <> oAncs.Font.Italic)) or
       (Underline and (Underline <> oAncs.Font.Underline)) then
    begin
      sWork := TGB+TAG_CHARACTERISTICS+SPC+ATTR_BOLD+ATB + Bool2Str(Bold);
      sWork := sWork + ATN+ATTR_ITALIC+ATB + Bool2Str(Italic);
      sWork := sWork + ATN+ATTR_UNDERLINE+ATB + Bool2Str(Underline) + ATE;
      Lines.Add(TABS[3] + sWork);
    end;

    // Do we need to store features?
    if (Outline and (Outline <> oAncs.Font.Outline)) or
       (Shadow and (Shadow <> oAncs.Font.Shadow)) or
       (Glow and (Glow <> oAncs.Font.Glow)) then
    begin
      sWork := TGB+TAG_FEATURES+SPC+ATTR_OUTLINE+ATB + Bool2Str(Outline);
      sWork := sWork + ATN+ATTR_SHADOW+ATB + Bool2Str(Shadow);
      sWork := sWork + ATN+ATTR_GLOW+ATB + Bool2Str(Glow) + ATE;
      Lines.Add(TABS[3] + sWork);
    end;

    // Do we need to store outline ?
    if ((FOutlineColour <> nil) and (FOutlineColour <> oAncs.OutlineColour)) or
       ((FVirtOutlineWidth <> 0) and (FVirtOutlineWidth <> oAncs.VirtualOutlineWidth)) then
    begin
      Lines.Add(TABS[3] + TGB+TAG_OUTLINE+TGC);
      if (FOutlineColour <> nil) and (FOutlineColour <> oAncs.OutlineColour) then
        Lines.Add(TABS[4] + FOutlineColour.XMLReference);
      if (FVirtOutlineWidth <> 0) and (FVirtOutlineWidth <> oAncs.VirtualOutlineWidth) then
        Lines.Add(TABS[4] + TGB+TAG_THICKNESS+TGC + IntToStr(FVirtOutlineWidth) + TGE+TAG_THICKNESS+TGC);
      Lines.Add(TABS[3] + TGE+TAG_OUTLINE+TGC);
    end;

    // Do we need to store shadow ?
    if ((FShadowColour <> nil) and (FShadowColour <> oAncs.ShadowColour)) or
       ((FVirtShadowX <> 0) and (FVirtShadowX <> oAncs.VirtualShadowXOffset)) or
       ((FVirtShadowY <> 0) and (FVirtShadowY <> oAncs.VirtualShadowYOffset)) then
    begin
      Lines.Add(TABS[3] + TGB+TAG_SHADOW+TGC);
      if (FShadowColour <> nil) and (FShadowColour <> oAncs.ShadowColour) then
        Lines.Add(TABS[4] + FShadowColour.XMLReference);
      if ((FVirtShadowX <> 0) and (FVirtShadowX <> oAncs.VirtualShadowXOffset)) or
         ((FVirtShadowY <> 0) and (FVirtShadowY <> oAncs.VirtualShadowYOffset)) then
        Lines.Add(TABS[4] + TGB+TAG_OFFSET+TGC + IntToStr(FVirtShadowX) + ',' +
                  IntToStr(FVirtShadowY) + TGE+TAG_OFFSET+TGC);
      Lines.Add(TABS[3] + TGE+TAG_SHADOW+TGC);
    end;
  end;
end;

procedure TAHMFont.ParseFromXML(XML: TAHMXMLHelper);
var
  sTypeface, sSize, sColour, sThickness: String;
  iX, iY: Integer;
  FontNode, PropsNode, DetailNode: TAHMXMLNode;
begin
  // Initialise parsing nodes
  FontNode := XML.CurrentNode;
  PropsNode := nil;

  // All font elements are optional, so lets see what we've got
  while XML.NextElement(FontNode, PropsNode) do
    with ApplicationManagerInstance.ThemeManager.VisualDescriptor do
    begin
      if XML.CurrentElement = TAG_TYPEFACE then
      begin
        sTypeface := XML.GetValue;
        if sTypeface <> '' then Font.Typeface := sTypeface;
      end
      else if XML.CurrentElement = TAG_SIZE then
      begin
        sSize := XML.GetValue;
        if sSize <> '' then VirtualSize := StrToInt(sSize);
      end
      else if XML.CurrentElement = TAG_COLOUR then
      begin
        sColour := XML.GetAttribute(ATTR_NAME);
        if sColour <> '' then Colour := ColourList.GetColour(sColour);
      end
      else if XML.CurrentElement = TAG_CHARACTERISTICS then
      begin
        // Read font characteristics (bold, italic, underline)
        Font.Bold      := Str2Bool(XML.GetAttribute(ATTR_BOLD));
        Font.Italic    := Str2Bool(XML.GetAttribute(ATTR_ITALIC));
        Font.Underline := Str2Bool(XML.GetAttribute(ATTR_UNDERLINE));
      end
      else if XML.CurrentElement = TAG_FEATURES then
      begin
        // Read font features (outline, shadow, glow)
        Font.Outline := Str2Bool(XML.GetAttribute(ATTR_OUTLINE));
        Font.Shadow := Str2Bool(XML.GetAttribute(ATTR_SHADOW));
        Font.Glow := Str2Bool(XML.GetAttribute(ATTR_GLOW));
      end
      else if (XML.CurrentElement = TAG_OUTLINE) then
      begin
        DetailNode := nil;

        // Outline elements may be omitted for inherited fonts
        while XML.NextElement(PropsNode, DetailNode) do
          if XML.CurrentElement = TAG_COLOUR then
          begin
            sColour := XML.GetAttribute(ATTR_NAME);
            if sColour <> '' then OutlineColour := ColourList.GetColour(sColour);
          end
          else if XML.CurrentElement = TAG_THICKNESS then
          begin
            sThickness := XML.GetValue;

            // Default outline width to 1 if not specified, and no ancestor
            if sThickness <> '' then VirtualOutlineWidth := StrToInt(sThickness)
            else if Ancestor = nil then VirtualOutlineWidth := 1;
          end;
      end
      else if (XML.CurrentElement = TAG_SHADOW) then
      begin
        DetailNode := nil;

        // Shadow elements may be omitted for inherited fonts
        while XML.NextElement(PropsNode, DetailNode) do
        begin
          if XML.CurrentElement = TAG_COLOUR then
          begin
            sColour := XML.GetAttribute(ATTR_NAME);
            if sColour <> '' then ShadowColour  := ColourList.GetColour(sColour);
          end
          else if XML.CurrentElement = TAG_OFFSET then
          begin
            // Read shadow offset
            if not XML.GetCoordsValue(iX, iY) then
              LogParsingError(THM_PRS_VIS_MALFORMED_FONT_OFFSET_TAGS, Self);
            if iX <> 0 then VirtualShadowXOffset := iX;
            if iY <> 0 then VirtualShadowYOffset := iY;
          end;
        end;
      end;
    end;
end;

procedure TAHMFont.InvalidateUIObject(UIObject: TAHMUIObject);
begin
  // Changes to font, shadow or outline colour will invalidate the font
  if (UIObject = FColour) or (UIObject = FShadowColour) or (UIObject = FOutlineColour) then
    FFont.Invalidate;
end;

procedure TAHMFont.BuildProperties(Properties: TAHMUIPropertyList);
begin
{$IFDEF DESIGNER}
  inherited;

  // Build custom font properties
  Properties.Add('Colour', 'Colour', CAT_FONT, HINT_COLOUR);
  Properties.Add('Shadow Colour', 'ShadowColour', CAT_FONT, HINT_SHADOWCOLOUR);
  Properties.Add('Outline Colour', 'OutlineColour', CAT_FONT, HINT_OUTLINECOLOUR);
  Properties.Add('Outline Width', 'VirtualOutlineWidth', CAT_FONT, HINT_OUTLINEWIDTH);
  Properties.Add('Shadow X', 'VirtualShadowXOffset', CAT_FONT, HINT_SHADOWX);
  Properties.Add('Shadow Y', 'VirtualShadowYOffset', CAT_FONT, HINT_SHADOWY);
  Properties.Add('Size', 'VirtualSize', CAT_FONT, HINT_SIZE);
  Properties.Add('Typeface', 'Typeface', CAT_FONT, HINT_TYPEFACE);
  Properties.Add('Bold', 'Bold', CAT_FONT, HINT_BOLD);
  Properties.Add('Italic', 'Italic', CAT_FONT, HINT_ITALIC);
  Properties.Add('Underline', 'Underline', CAT_FONT, HINT_UNDERLINE);
  Properties.Add('Shadow', 'Shadow', CAT_FONT, HINT_SHADOW);
  Properties.Add('Outline', 'Outline', CAT_FONT, HINT_OUTLINE);
  Properties.Add('Glow', 'Glow', CAT_FONT, HINT_GLOW);
{$ENDIF}
end;

end.
